Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-20/nrd34.zip/NRD.PAS

Pascal/Delphi Source File | 1991-05-31 | 71KB | 2,255 lines

{$I-}
{$V-}
{$M 60000,0,655360}

{  ROUTINE:    N R D

   PURPOSE:    Control an NRD525 / NRD535 Receiver + database

   USAGE:    nrd

   AUTHOR:    Tom Whiteside 11505 Oak View, Austin, TX 78759 [phone]

   REVISION:    1.0  04-30-90  TGW  Initial Release
                1.1  07-07-90  TGW  Serial routines changed to use BIOS for
                                       Windows
                1.2  07-15-90  TGW  Efficiency tweaks to inc/dec bw/mode
                                    Cursor Highlighting for current line
                                    Cursor tracking data for inc/dec freq
                1.3  07-29-90  TGW  Remove H(ide from prompt, fix Delete
                                       leaving wrong line highlighted
                                    Added Revision to prompt
                1.4  09-03-90  TGW  Fixed inc/dec mode past boundary crashing
                                       program; asserted black backgrd on
                                       title and journal
                1.5  09-29-90  TGW  Added MAP feature

                1.6  11-18-90  TGW  Fixed 2 bugs where cursor got out of
                                    sync with "status line"
                2.0  12/01-90  TGW  Mods to support other com ports, optional
                                    MAP, help                                 easier for o
                2.1  12-02-90  TGW  Added time offset to config.dat; fixed
                                    home not putting cursor at top of screen

                2.2  12-25-90  TGW  Added "Com 0" feature to allow using prgm
                                    without serial port...
                2.3  12-27-90  TGW  Fix to eliminate hang if radio off

                2.4  03-02-91  TGW  Fix for monochrome users (in screen.pas)
                2.5  03-10-91  TGW  Added Import of Sundstrom data
                2.6  03-30-91  TGW  Added Active and Inactive log concept
                                    including write from the inactive log
                                    Added "*" command to find radio freq
                                    in database.  Fixed potential hang in
                                    comreadln.  Reduced edit field length
                                    for comments by 1 char.  (Fixed wrap bug
                                    for bottom line)  Removed dangerous Read
                                    command from Journal
                2.7  04-14-91  TGW  Fixed display bug in inc_freq
                3.0  04-26-91  TGW  Added NRD535 features
                3.1  04-27-91  TGW  Fix to journal name select; Added 535
                                    mode to auto-update receiver display
                3.2  05-12-91  TGW  Added S-meter to 535; changed mode order
                                    to AM -> ECSS_U; added graphics command
                                    for 535; misc bug fixes for 535

                3.3  05-19-91  TGW  Graphics enhancements; commands for time
                                    and spectral displays.  Performance
                                    enhancement to Spectral display
                3.4  05-31-91  TGW  Misc clean-up to 535 additions mainly to
                                    isolate receiver specific stuff to nrdio.
                                    Fixed minor BWC bug with Spectral plot.
                                    Fixed bug in Import not setting
                                    attenuator.  Fixed bug with Cursor going
                                    below end of file.  Improved key-stroke
                                    performance.  Added date and time stamp
                                    to the status line.  Cleaned up various
                                    bugs in Journal.
}
program nrd(input,output);

uses async, crt, dos, graph, screen, nrdio, nrdutil;

  procedure program_radio(log_entry:logtype);

  { set receiver to log entry; side effect - zaps channel 199 on 535 }

  begin
    remote_on;
    if radio_type = 535 then
        with log_entry do
          set_all(199,attenuator,bandwidth,mode,frequency,agc)
    else
      begin
        if map then {force to AM}
          begin
            set_freq(log_entry.frequency + MAP_OFFSET);
            set_mode(AM);
            set_bandwidth(WIDE);
            set_agc(FAST);
          end
        else {use log entry}
          begin
            set_freq(log_entry.frequency);
            if (radio_type = 525) and (log_entry.mode in [ECSS_USB,ECSS_LSB])
               then log_entry.mode:=AM;
            set_mode(log_entry.mode);
            set_bandwidth(log_entry.bandwidth);
            set_agc(log_entry.agc);
          end;
        set_attenuator(log_entry.attenuator);
      end;
    remote_off(REMOTE_DLY);
    update_receiver_display:=TRUE;
  end;

  procedure sync_loglist;
  var dummy:boolean;
      i,y_pos:integer;
      recnum:integer;
  begin
    y_pos:=wherey;
    i:=loglist.currentlog;
    loglist.log[i].records:=records;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    if recnum = 0 then recnum:=1; { handle special case of empty log }
    loglist.log[i].rec:=recnum;
    put_loglist(loglist);
  end;

  procedure do_mark;
  var recnum:integer;
      dummy:boolean;

  begin
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    if recnum < min_mark then min_mark:=recnum;
    if recnum > max_mark then max_mark:=recnum;
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_unmark(display:boolean);
  begin
    x_pos:=wherex; y_pos:=wherey;
    max_mark:=0;
    min_mark:=MAXREC + 1;
    if display then show_log(rec,TRUE,TRUE);
  end;

  procedure do_undelete;
  var t,recnum:integer;
      x_pos,y_pos:integer;
      dummy:boolean;
      i,j:integer;
      ch:char;
  begin
    write_prompt('uNdelete:  Type "y" to continue');
    ch:=upcase(fetch);
    cmd_prompt(prompt_num);
    bottom_window;
    if ch <> 'Y' then exit;
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    i:=records;

    while (i > 1) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
      do i:=i - 1;
    if recdata.recstat[recdata.recptr[i]] = DELETED then { found one }
      begin
        t:=recdata.recptr[i];
        recdata.recstat[t]:=SHOW;
        for j:=i downto recnum + 1 do
          recdata.recptr[j]:=recdata.recptr[j - 1];
        recdata.recptr[recnum]:=t;
        put_recdata(loglist.currentlog,recdata);
        show_log(rec,TRUE,TRUE);
      end;
  end;

  procedure do_sort(auto:boolean);
  var sortdata:sort_array_type;
      subsortdata:sort_array_type;
      primary,secondary:char;

    function get_sort_type(auto:boolean; var primary, secondary:char):boolean;
    begin
      if auto then { automatically do Frequency, Time sort }
        begin
          get_sort_type:=TRUE;
          primary:='F';
          secondary:='T';
          exit;
        end;
      repeat
        write_prompt('Sort - Primary field: D(ate, T(ime, F(req, C(all,'
                     +' L(oc, M(ode, Q(uit');
        primary:=upcase(fetch);
      until primary in ['D','T','F','C','L','M','Q'];
      if primary <> 'Q' then
        repeat
          write_prompt('Sort - Secondary field: D(ate, T(ime, F(req, C(all,'
                     +' L(oc, M(ode, Q(uit');
          secondary:=upcase(fetch);
        until secondary in ['D','T','F','C','L','M','Q'];
      cmd_prompt(prompt_num);
      bottom_window;
      get_sort_type:=(primary <> 'Q') and (secondary <> 'Q');
    end;

    procedure get_fields;
    var i:integer;
        logdata:logtype;

      procedure init_array(var sortdata:short_str; cmd:char);
      begin
        case cmd of
          'D':sortdata:=copy(logdata.date,1,SHORTSTRLEN);
          'T':sortdata:=copy(logdata.begin_time,1,SHORTSTRLEN);
          'F':str(logdata.frequency:8:1,sortdata);
          'C':sortdata:=copy(logdata.callsign,1,SHORTSTRLEN);
          'L':sortdata:=copy(logdata.location,1,SHORTSTRLEN);
          'M':case logdata.mode of
                RTTY:sortdata:='RTTY';
                CW  :sortdata:='CW';
                USB :sortdata:='USB';
                LSB :sortdata:='LSB';
                AM  :sortdata:='AM';
                FM  :sortdata:='FM';
                FAX :sortdata:='FAX';
               end;
        end;
      end;

    begin
      home;
      for i:=1 to records do
      begin
        if recdata.recstat[i] = DELETED then { dummy sort pos }
          begin
            sortdata[i]:=chr(255);
            subsortdata[i]:=chr(255);
          end
        else
          begin
            get_log(logbuf,logdata,i);
            init_array(sortdata[i],primary);
            init_array(subsortdata[i],secondary);
          end;
        recdata.recptr[i]:=i;
      end;
    end;

    procedure primary_sort; { sort on primary field }
    begin
      write(output,'Primary sort');
      sort(sortdata,recdata.recptr,1,records);
    end;

    procedure secondary_sort; { sort on secondary field }
    var i,top:integer;
        tempstr:string;
    begin
      top:=1; home;
      write(output,'Secondary sort');
      while (top < records) do
        begin
          i:=0;
          tempstr:=sortdata[top];
          while (top + i < records) and (tempstr = sortdata[top + i]) do
            begin
              sortdata[top + i]:=subsortdata[recdata.recptr[top + i]];
              inc(i);
            end;
          sort(sortdata,recdata.recptr,top,i);
          top:=top + i;
        end;
    end;

  begin
    if get_sort_type(auto,primary,secondary) then
      begin
        get_fields;
        primary_sort;
        secondary_sort;
      end;
    show_log(rec,TRUE,TRUE);
    put_recdata(loglist.currentlog,recdata);
  end;

  function upcasestr(s:string):string;
  var i:integer;
      s1:string;
  begin
    s1:=s;
    for i:=1 to length(s) do s1[i]:=upcase(s[i]);
    upcasestr:=s1;
  end;

  procedure do_page;
  begin
    x_pos:=wherex; y_pos:=wherey;
    display_page:=display_page + 1;
    if display_page > 3 then display_page:=1;
    draw_display_titles;
    bottom_window;
    if rslt = 0 then show_log(rec,TRUE,TRUE);
  end;

  procedure do_tab;
  begin
    x_pos:=wherex; y_pos:=wherey;
    case display_page of
      1:begin
          if x_pos in [1..5]   then x_pos:=6  else
          if x_pos in [6..12]  then x_pos:=13 else
          if x_pos in [13..17] then x_pos:=18 else
          if x_pos in [18..22] then x_pos:=23 else
          if x_pos in [23..31] then x_pos:=32 else
          if x_pos in [32..51] then x_pos:=52 else
            begin
              x_pos:=11;
              gotoxy(x_pos,y_pos);
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
      2:begin
          x_pos:=32;
          gotoxy(x_pos,y_pos);
          do_page;
        end;
      3:begin
          if x_pos in [1..5]   then x_pos:=6  else
          if x_pos in [6..12]  then x_pos:=13 else
          if x_pos in [13..17] then x_pos:=18 else
          if x_pos in [18..22] then x_pos:=23 else
          if x_pos in [23..31] then x_pos:=32 else
          if x_pos in [32..36] then x_pos:=37 else
          if x_pos in [37..42] then x_pos:=43 else
          if x_pos in [43..48] then x_pos:=49 else
            begin
              x_pos:=6;
              gotoxy(x_pos,y_pos);
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
    end;
  end;

  procedure do_backtab;
  begin
    x_pos:=wherex; y_pos:=wherey;
    case display_page of
      1:begin
          if x_pos in [7..13]  then x_pos:=6  else
          if x_pos in [14..18] then x_pos:=13 else
          if x_pos in [19..23] then x_pos:=18 else
          if x_pos in [24..32] then x_pos:=23 else
          if x_pos in [33..80] then x_pos:=32 else
            begin
              x_pos:=38;
              gotoxy(x_pos,y_pos);
              display_page:=display_page - 2;
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
      2:begin
          if x_pos in [3..10]  then x_pos:=2  else
          if x_pos in [12..80] then x_pos:=11 else
            begin
              x_pos:=52;
              gotoxy(x_pos,y_pos);
              display_page:=display_page - 2;
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
      3:begin
          if x_pos in [7..13]  then x_pos:=6  else
          if x_pos in [14..18] then x_pos:=13 else
          if x_pos in [19..23] then x_pos:=18 else
          if x_pos in [24..32] then x_pos:=23 else
          if x_pos in [33..37] then x_pos:=32 else
          if x_pos in [38..43] then x_pos:=37 else
          if x_pos in [44..49] then x_pos:=43 else
          if x_pos in [50..80] then x_pos:=49 else
            begin
              x_pos:=11;
              gotoxy(x_pos,y_pos);
              display_page:=display_page - 2;
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
    end;
  end;

  procedure do_edit; { edit field cursor is on }
  var recnum:integer;
      logdata:logtype;
      s:string;
      i,j,y,dummy:integer;
      tabkey,backtabkey:boolean;

    procedure edit_page1;
    begin
      case x_pos of
         6..12: editfield(5, y,DATELEN,FALSE,tabkey,backtabkey,logdata.date);
        13..17: begin
                  editfield(12,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.begin_time);
                  while length(logdata.begin_time) < 4 do
                      logdata.begin_time:=concat('0',logdata.begin_time);
                end;
        18..22: begin
                  editfield(17,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.end_time);
                  while length(logdata.end_time) < 4 do
                      logdata.end_time:=concat('0',logdata.end_time);
                end;
        23..31: begin
                  str(logdata.frequency:8:2,s);
                  editfield(22,y,8,TRUE,tabkey,backtabkey,s);
                  val(s,logdata.frequency,dummy);
                end;
        32..51: editfield(31,y,CALLSIGNLEN,FALSE,tabkey,backtabkey
                              ,logdata.callsign);
        52..80: editfield(51,y,LOCATIONLEN,FALSE,tabkey,backtabkey
                              ,logdata.location);
      end;
    end;

    procedure edit_page2;
    begin
      case x_pos of
         1..10: begin
                  str(logdata.frequency:8:2,s);
                  editfield(1,y,8,TRUE,tabkey,backtabkey,s);
                  val(s,logdata.frequency,dummy);
                end;
        11..80: editfield(10,y,COMMENTLEN-1,FALSE,tabkey,backtabkey
                              ,logdata.comment);
      end;
    end;

    procedure edit_page3;
    begin
      case x_pos of
         6..12: editfield(5, y,DATELEN,FALSE,tabkey,backtabkey,logdata.date);
        13..17: begin
                  editfield(12,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.begin_time);
                  while length(logdata.begin_time) < 4 do
                      logdata.begin_time:=concat('0',logdata.begin_time);
                end;
        18..22: begin
                  editfield(17,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.end_time);
                  while length(logdata.end_time) < 4 do
                      logdata.end_time:=concat('0',logdata.end_time);
                end;
        23..31: begin
                  str(logdata.frequency:8:2,s);
                  editfield(22,y,8,TRUE,tabkey,backtabkey,s);
                  val(s,logdata.frequency,dummy);
                end;
        32..36: begin
                  case logdata.mode of
                    RTTY: s:='RTTY';
                    CW:   s:=' CW';
                    USB:  s:='USB';
                    LSB:  s:='LSB';
                    AM:   s:=' AM';
                    FM:   s:=' FM';
                    FAX:  s:='FAX';
                  end;
                  editfield(31,y,4,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('RTTY',s) > 0 then logdata.mode:=RTTY else
                  if pos('CW',s)   > 0 then logdata.mode:=CW   else
                  if pos('USB',s)  > 0 then logdata.mode:=USB  else
                  if pos('LSB',s)  > 0 then logdata.mode:=LSB  else
                  if pos('AM',s)   > 0 then logdata.mode:=AM   else
                  if pos('FM',s)   > 0 then logdata.mode:=FM   else
                  if pos('FAX',s)  > 0 then logdata.mode:=FAX
                end;
        37..42: begin
                  case logdata.bandwidth of
                    NARR: s:=' NARR';
                    INTER:s:='INTER';
                    WIDE: s:=' WIDE';
                    AUX:  s:=' AUX';
                  end;
                  editfield(36,y,5,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('INTER',s) > 0 then logdata.bandwidth:=INTER else
                  if pos('NARR',s)  > 0 then logdata.bandwidth:=NARR  else
                  if pos('WIDE',s)  > 0 then logdata.bandwidth:=WIDE  else
                  if pos('AUX' ,s)  > 0 then logdata.bandwidth:=AUX
                end;
        43..48: begin
                  case logdata.agc of
                    FAST: s:='FAST';
                    SLOW: s:='SLOW';
                    OFF:  s:=' OFF';
                  end;
                  editfield(42,y,4,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('FAST',s) > 0 then logdata.agc:=FAST else
                  if pos('SLOW',s) > 0 then logdata.agc:=SLOW else
                  if pos('OFF',s)  > 0 then logdata.agc:=OFF
                end;
        49..51: begin
                  case logdata.attenuator of
                    YES: s:='ON';
                    NO:  s:='OFF';
                  end;
                  editfield(48,y,3,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('OFF',s) > 0 then logdata.attenuator:=NO else
                  if pos('ON',s)  > 0 then logdata.attenuator:=YES
                end;
      end;
    end;

  begin { do_edit }
    x_pos:=wherex; y_pos:=wherey; y:=y_pos - 1;
    recnum:=rec - 1;
    if precess(recnum,y_pos) then
      begin
        get_log(logbuf,logdata,recdata.recptr[recnum]);
        case display_page of
          1: edit_page1;
          2: edit_page2;
          3: edit_page3;
        end;
        put_log(logbuf,logdata,recdata.recptr[recnum]);
        if not (tabkey or backtabkey) then
          begin
            gotoxy(x_pos,y_pos);
            show_log(rec,TRUE,TRUE);
          end;
      end;
    gotoxy(x_pos,y_pos);
    if tabkey then
      begin
        do_tab;
        do_edit;
      end
    else if backtabkey then
      begin
        do_backtab;
        do_edit;
      end;
  end;

  procedure do_delete;
  var x_pos,y_pos:integer;
      recnum:integer;
      ch:char;
      i,t:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    write_prompt('Delete:  Type "y" to continue');
    ch:=upcase(fetch);
    cmd_prompt(prompt_num);
    bottom_window;
    if ch = 'Y' then if precess(recnum,y_pos) then
      begin
        t:=recdata.recptr[recnum];
        recdata.recstat[t]:=DELETED;
        for i:=recnum to records - 1 do with recdata do
          recptr[i]:=recptr[i + 1];
        recdata.recptr[records]:=t;
        show_log(rec,TRUE,TRUE);
        put_recdata(loglist.currentlog,recdata);
      end;
  end;

  procedure do_log;
  var x_pos,y_pos:integer;
      t,recnum:integer;
      ch:char;
      i,j:integer;
      dummy:boolean;
      logdata:logtype;
  begin
    x_pos:=32; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    { get receiver status }
    if radio_type = 525 then remote_on else toggle_remote;
    show_receiver;
    remote_off(0);
    i:=1;
    while (i < records) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
       do inc(i);
    if (i >= records) and (recdata.recstat[recdata.recptr[i]]<>DELETED) then
      { insert new entry here }
      begin
        inc(records);
        i:=records;
        recdata.recptr[i]:=i;
        loglist.log[loglist.currentlog].records:=records;
        put_loglist(loglist);
      end;
    t:=recdata.recptr[i];
    if recnum = 0 then recnum:=1; { special case for new arrays }
    for j:=i downto recnum + 1 do with recdata do
      recptr[j]:=recptr[j - 1];
    recdata.recptr[recnum]:=t;
    recdata.recstat[t]:=SHOW;
    clear_log(logdata);
    with receiverstat do
      begin
        if map then {center frequency}
          begin
            logdata.frequency:=trunc(frequency/5.0 + 0.5) * 5;
            logdata.mode:=USB;
            logdata.bandwidth:=INTER;
          end
        else
          begin
            logdata.frequency:=frequency;
            logdata.mode:=mode;
            logdata.bandwidth:=bandwidth;
          end;
        logdata.agc:=agc;
        logdata.attenuator:=attenuator;
      end;
    put_log(logbuf,logdata,recdata.recptr[recnum]);
    put_recdata(loglist.currentlog,recdata);
    if display_page <> 1 then
      begin
        display_page:=1;
        draw_display_titles;
        bottom_window;
      end;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
    do_edit;
  end;

  procedure do_tune;

  { assign log entry at cursor location to radio }

  var recnum:integer;
      logdata:logtype;
  begin
   y_pos:=wherey;
   recnum:=rec - 1;
   if precess(recnum, y_pos) then
     begin
       get_log(logbuf,logdata,recdata.recptr[recnum]);
       program_radio(logdata);
       if radio_type = 535 then toggle_remote;
     end;
  end;

  function find_rec(rec:integer; freq:real):integer; { find record >= frequency }
  var j:integer;
      logdata:logtype;
      first_try, found:boolean;
  begin
    j:=rec - 20; { skip back enuf records to find start hopefully }
    if j < 0 then j:=0;
    found:=FALSE; first_try:=TRUE;
    while (j < records) and not found do
      begin
        if precess(j,1) then
          begin
            get_log(logbuf,logdata,recdata.recptr[j]);
            if first_try and (logdata.frequency > freq)
              then j:=0
              else found:=logdata.frequency >= freq;
            first_try:=FALSE;
          end;
      end;
    find_rec:=j;
  end;

  procedure inc_freq;
  var s:string;
      x_pos,y_pos,i:integer;
      orig_freq:real;

    procedure display(frequency:real); { find displayed line matching freq }
    var found,lt:boolean;
        j:integer;
    begin
      j:=0; found:=FALSE; lt:=FALSE;
      while (j < LINES - REC_WIN_Y_BOTTOM - 1) and not found do
        begin
          inc(j);
          if frequency > displayed_freq[j] then lt:=TRUE; {condition for fnd}
          found:=frequency <= displayed_freq[j];
        end;
      if found and lt then { found it and its on the screen }
        begin
          y_pos:=j;
          gotoxy(x_pos,y_pos);
          show_log(rec,FALSE,TRUE);
        end
      else { new screen }
        begin
          rec:=find_rec(rec, frequency);
          gotoxy(x_pos,1);
          show_log(rec,TRUE,TRUE);
        end;
    end;

  begin {inc_freq}
    x_pos:=wherex; y_pos:=wherey;
    show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
    with receiverstat do
      begin
        remote_on;
        orig_freq:=frequency;
        frequency:=trunc(frequency/10.0) * 10.0;
        if orig_freq - frequency >= 5.0 then frequency:=frequency + 5.0;
        case mode of
          USB: set_freq(frequency + 4.0);
          LSB: set_freq(frequency + 6.0);
          AM:
          else
            begin
              for i:=1 to 4 do
                begin
                  set_freq(frequency + i);
                  delay(150);
                end;
            end;
        end;
        delay(200);
        frequency:=frequency + 5.0;
        if map then frequency:=frequency + MAP_OFFSET;
        set_freq(frequency);
        remote_off(0);
        if radio_type = 535 then toggle_remote;
        show_receiver;
        display(frequency);
      end;
  end;

  procedure dec_freq;
  var s:string;
      x_pos,y_pos,i:integer;
      orig_freq:real;

    procedure display(frequency:real); { find displayed line matching freq }
    var found,lt:boolean;
        j:integer;
    begin
      j:=LINES - REC_WIN_Y_BOTTOM; found:=FALSE; lt:=FALSE;
      while (j > 1) and not found do
        begin
          dec(j);
          if frequency < displayed_freq[j] then lt:=TRUE;{condition for fnd}
          found:=frequency >= displayed_freq[j];
        end;
      if found and lt then { found it and its on the screen }
        begin
          gotoxy(x_pos,j);
          show_log(rec,FALSE,TRUE);
        end
      else { new screen }
        begin
          rec:=find_rec(rec, frequency);
          rec:=rec - LINES + REC_WIN_Y_BOTTOM + 2;
          if rec < 1 then rec:=1;
          gotoxy(x_pos,1);
          show_log(rec,TRUE,TRUE);
          show_log(rec,FALSE,FALSE);
          y_pos:=0; found:=FALSE;
          while not found and (y_pos < LINES - REC_WIN_Y_BOTTOM - 1) do
            begin
              inc(y_pos);
              found:=displayed_freq[y_pos] >=frequency;
            end;
          gotoxy(x_pos,y_pos);
          show_log(rec,FALSE,TRUE);
        end;
    end;

  begin {dec_freq}
    x_pos:=wherex; y_pos:=wherey;
    show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
    with receiverstat do
      begin
        remote_on;
        orig_freq:=frequency;
        frequency:=trunc(frequency/10.0) * 10.0;
        if orig_freq - frequency > 5.0 then frequency:=frequency + 10.0
        else if orig_freq - frequency > 0.0 then frequency:=frequency + 5.0;
        case mode of
          USB: set_freq(frequency - 6.0);
          LSB: set_freq(frequency - 4.0);
          AM:
          else
            begin
              for i:=1 to 4 do
                begin
                  set_freq(frequency - i);
                  delay(150);
                end;
            end;
        end;
        delay(200);
        frequency:=frequency - 5.0;
        if map then frequency:= frequency + MAP_OFFSET;
        set_freq(frequency);
        remote_off(0);
        if radio_type = 535 then toggle_remote;
        show_receiver;
        display(receiverstat.frequency);
      end;
  end;

  procedure find_freq;
  var s:string;
      x_pos,y_pos,i:integer;
      orig_freq:real;
      ch:char;

    procedure display(frequency:real); { find displayed line matching freq }
    var found:boolean;
    begin
      rec:=find_rec(1, frequency);
      rec:=rec - LINES + REC_WIN_Y_BOTTOM + 2;
      if rec < 1 then rec:=1;
      gotoxy(x_pos,1);
      show_log(rec,TRUE,TRUE);
      show_log(rec,FALSE,FALSE);
      y_pos:=0; found:=FALSE;
      while not found and (y_pos < LINES - REC_WIN_Y_BOTTOM - 1) do
        begin
          inc(y_pos);
          found:=displayed_freq[y_pos] >=frequency;
        end;
      gotoxy(x_pos,y_pos);
      show_log(rec,FALSE,TRUE);
    end;

  begin {find_freq}
    x_pos:=wherex; y_pos:=wherey;
    show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
    with receiverstat do
      begin
        if radio_type = 525 then remote_on
        else toggle_remote;
        remote_off(0);
        show_receiver;
        display(receiverstat.frequency);
      end;
  end;

  procedure do_kiwa; { different mode if KIWA MAP unit in use }
  var freq,offset:real;
      x_pos,y_pos:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    map:=not map; {toggle mode}
    with receiverstat do
      begin
        if map then {enable mode}
          begin
            if mode = USB then offset:=MAP_OFFSET else offset:=-MAP_OFFSET;
            remote_on;
            set_mode(AM);
            mode:=AM;
            set_bandwidth(WIDE);
            bandwidth:=WIDE;
            set_agc(FAST);
            agc:=FAST;
            frequency:=trunc(frequency / 5.0 + 0.5) * 5.0 + offset;
            set_freq(frequency);
            remote_off(REMOTE_DLY);
          end
        else
          begin
            remote_on;
            freq:=frequency;
            frequency:=trunc(frequency / 5.0 + 0.5) * 5.0;
            set_freq(frequency);
            if frequency < freq then
              begin
                set_mode(USB);
                mode:=USB;
              end
            else
              begin
                set_mode(LSB);
                mode:=LSB;
              end;
            set_bandwidth(INTER);
            bandwidth:=INTER;
          end;
        remote_off(REMOTE_DLY);
      end;
    show_receiver;
    gotoxy(x_pos,y_pos);
  end;

  procedure do_confirm;

  { refresh database time and date and receiver status }

  var recnum:integer;
      tlog,logdata:logtype;
      t_begin, t_end, t_now, dummy:integer;
      ch:char;
      s:string;
  begin
   x_pos:=wherex; y_pos:=wherey;
   { get receiver status }
   if radio_type = 525 then remote_on
   else
     begin
       toggle_remote;
       if async_buffer_check(ch) then check_status(s);
     end;
   show_receiver;
   remote_off(0);
   recnum:=rec - 1;
   if precess(recnum, y_pos) then
     begin
      clear_log(tlog);
      get_log(logbuf,logdata,recdata.recptr[recnum]);
      write_prompt('Confirm:  Type "y" to continue');
      ch:=upcase(fetch);
      cmd_prompt(prompt_num);
      if ch = 'Y' then
        begin
          logdata.date:=tlog.date;
          val(tlog.begin_time,t_now,dummy);
          val(logdata.begin_time,t_begin,dummy);
          val(logdata.end_time,t_end,dummy);
          t_begin:=t_begin - t_now;
          if t_begin < 0 then t_begin:=t_begin + 2400;
          t_end:=t_now - t_end;
          if t_end < 0 then t_end:=t_end + 2400;
          if t_begin < t_end
             then if t_begin < 1200 then logdata.begin_time:=tlog.begin_time;
          if t_end < t_begin
             then if t_end < 1200 then logdata.end_time:=tlog.begin_time;
          with receiverstat do
            begin
              if not map then {don't update receiver params if using map}
                begin
                  logdata.frequency:=frequency;
                  logdata.mode:=mode;
                  logdata.agc:=agc;
                  logdata.attenuator:=attenuator;
                  logdata.bandwidth:=bandwidth;
                end;
            end;
          put_log(logbuf,logdata,recdata.recptr[recnum]);
        end;
      end;
   bottom_window;
   show_log(rec,TRUE,TRUE);
  end;

  procedure do_write; { as in dudley... }
  { copy record at cursor in inactive log to current log }
  var x_pos,y_pos:integer;
      t,recnum:integer;
      ch:char;
      i,j:integer;
      dummy:boolean;
  begin
    if last_log = 0 then exit;
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    i:=1;
    while (i < records) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
       do inc(i);
    if (i >= records) and (recdata.recstat[recdata.recptr[i]]<>DELETED) then
      { insert new entry here }
      begin
        inc(records);
        i:=records;
        recdata.recptr[i]:=i;
        loglist.log[loglist.currentlog].records:=records;
        put_loglist(loglist);
      end;
    t:=recdata.recptr[i];
    if recnum = 0 then recnum:=1; { special case for new arrays }
    for j:=i downto recnum + 1 do with recdata do
      recptr[j]:=recptr[j - 1];
    recdata.recptr[recnum]:=t;
    recdata.recstat[t]:=SHOW;
    put_log(logbuf,last_log_data,recdata.recptr[recnum]);
    put_recdata(loglist.currentlog,recdata);
    if display_page <> 1 then
      begin
        display_page:=1;
        draw_display_titles;
        bottom_window;
      end;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_pageup(cnt:byte);
  var i,j:integer;
      dummy:boolean;
      last:boolean;
  begin
    x_pos:=wherex;
    for j:=1 to cnt do
      begin
        for i:=1 to LINES - REC_WIN_Y_BOTTOM + 1 do
          begin
            if rec > 1 then dec(rec);
            while (rec > 1) and (recdata.recstat[recdata.recptr[rec]]
                    <> SHOW) do dec(rec);
          end;
      end;

    { place cursor at bottom (or last record) }
    y_pos:=0;
    j:=rec - 1;
    last:=FALSE;
    for i:=2 to LINES - REC_WIN_Y_BOTTOM  do
      begin
        dummy:=precess(j,1);
        if (recdata.recstat[recdata.recptr[j]] = SHOW) and (not last)
           then inc(y_pos);
        last:=j = records; { funky ending condition; j won't exceed records}
      end;
    gotoxy(x_pos,y_pos);
    if rslt = 0 then show_log(rec,TRUE,TRUE);
  end;

  procedure do_pagedown(cnt:byte);
  var i:integer;
      dummy:boolean;
  begin
    x_pos:=wherex; y_pos:=1;
    gotoxy(x_pos,y_pos);
    for i:=1 to cnt do
      begin
        dummy:= precess(rec, LINES - REC_WIN_Y_BOTTOM - 1);
        if rec >= records then
          begin
             rec:=records;
             if rec < 1 then rec:=1; { special case for empty file }
             while (recdata.recstat[recdata.recptr[rec]] <> SHOW) do
               dec(rec);
          end;
      end;
    if rslt = 0 then show_log(rec,TRUE,TRUE);
  end;

  procedure do_up;
  begin
    x_pos:=wherex; y_pos:=wherey;
    y_pos:=y_pos - 1;
    if y_pos < 1 then
      begin
        y_pos:=1;
        if rec > 1 then rec:=rec - 1;
        show_log(rec,TRUE,TRUE);
      end
    else
      begin
        show_log(rec,FALSE,FALSE);
        gotoxy(x_pos,y_pos);
        show_log(rec,FALSE,TRUE);
      end;
  end;

  procedure do_down;
  var dummy:boolean;
      i,y,j:integer;
  begin
    x_pos:=wherex; y:=wherey;
    inc(y);

    { keep cursor from moving past bottom }
    j:=rec - 1;
    for i:=1 to y do
      begin
        inc(j);
        if (j > records) or (recdata.recstat[recdata.recptr[j]]<>SHOW) then
          begin
            y_pos:=wherey;
            exit;
          end;
      end;
    y_pos:=y;
    if y_pos > LINES - REC_WIN_Y_BOTTOM - 1 then
     begin
       y_pos:=LINES - REC_WIN_Y_BOTTOM - 1;
       dummy:=precess(rec,1);
       if rec > records then rec:=records;
       if rslt = 0 then show_log(rec,TRUE,TRUE);
     end
    else
      begin
        show_log(rec,FALSE,FALSE);
        gotoxy(x_pos,y_pos);
        show_log(rec,FALSE,TRUE);
      end;
  end;

  procedure do_right;
  begin
    x_pos:=wherex; y_pos:=wherey;
    inc(x_pos);
    if x_pos > CHARPERLINE then
      begin
        x_pos:=1;
        inc(display_page);
        if display_page > 3 then display_page:=1;
        draw_display_titles;
        bottom_window;
        if rslt = 0 then show_log(rec,TRUE,TRUE);
      end;
    gotoxy(x_pos,y_pos);
  end;

  procedure do_left;
  begin
    x_pos:=wherex; y_pos:=wherey;
    x_pos:=x_pos - 1;
    if x_pos < 1 then
      begin
        x_pos:=CHARPERLINE;
        display_page:=display_page - 1;
        if display_page < 1 then display_page:=3;
        draw_display_titles;
        bottom_window;
        if rslt = 0 then show_log(rec,TRUE,TRUE);
      end;
    gotoxy(x_pos,y_pos);
  end;

  procedure do_home;
  begin
    rec:=1; x_pos:=1; y_pos:=1;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_end;
  begin
    rec:=records; x_pos:=1; y_pos:=1;
    do_pagedown(1);
  end;

  procedure new_log(lognum:byte; var rslt:integer);
  begin
    open_log(logbuf,lognum, rslt);
    get_recdata(lognum, recdata);
    records:=loglist.log[lognum].records;
    rec:=loglist.log[lognum].rec;
  end;

  procedure do_alternate;
  var i:integer;
      recnum:integer;
      t_begin, t_end, t_now, dummy:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    sync_loglist;
    if loglist.currentlog > 0 then { window current rec for "W" command }
      begin
        new_log(loglist.currentlog,rslt);
        if loglist.log[loglist.currentlog].records > 0 then
          begin
            if precess(recnum, y_pos) then
              get_log(logbuf,last_log_data,recdata.recptr[recnum]);
          end
        else clear_log(last_log_data);
        close(logbuf);
      end;
    if last_log > 0 then { there is a log to alternate to }
      begin
        i:=last_log;
        last_log:=loglist.currentlog;
        loglist.currentlog:=i;
        put_loglist(loglist);
        do_unmark(FALSE);
      end;
    status_window;
    bottom_window;
    new_log(loglist.currentlog,rslt);
    x_pos:=1; y_pos:=1;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure update_time_status;
  var the_date:string;
      the_time:string;
  begin
    x_pos:=wherex; y_pos:=wherey;
    the_date:=mon_str + '/' + day_str + '/' + year_str;
    the_time:=copy(time_str,1,2) + ':' + copy(time_str,3,2) + ':' +
              copy(time_str,5,2);
    window(1,25,80,25);
    gotoxy(62,1);
    writea(BLACK,BACKGROUND);
    writea(CYAN, FOREGROUND);
    write(output,the_date,'  ', the_time);
    bottom_window;
  end;

  procedure do_journal;
  var ch:char;
      new:integer;
      found:boolean;

    procedure clr_prompt;
    begin
      gotoxy(1,2); clreol;
    end;

    procedure do_select(s:string; var new:integer; var found:boolean);
    var dummy1,dummy2:boolean;
        i, j, code, cmd:integer;
        ch:char;
        t,t1,t2:string;
    begin
      repeat
        clr_prompt;
        t2:='Enter log name or number ' + s + ' (Enter for none):';
        write(output,t2);
        t:='';
        editfield(length(t2) + 1,1,6,FALSE,dummy1,dummy2,t);
        t:=upcasestr(t);

        { search for duplicate }
        found:=FALSE;
        i:=0;
        while (i < MAXLOGS) and not found do
          begin
            inc(i);
            with loglist.log[i] do if t = logname then found:=TRUE;
          end;

        if not found then {see if they entered the log # instead of the name}
          begin
            t2:='';
            for i:=1 to length(t) do
              if (t[i] in ['0'..'9']) then t2:=t2 + t[i];
            val(t2, cmd, code);
            if code = 0 then
              begin
                i:=0; j:=0;
                while (j < cmd) and (i < MAXLOGS) do
                  begin
                    inc(i);
                    inc(j);
                    while (i < MAXLOGS) and (loglist.log[i].logname = '') do
                       inc(i);
                  end;
                found:=loglist.log[i].logname <> '';
              end;
          end;

        if not found and (t[1] <> ' ') then
          begin
            clr_prompt;
            write(output,'Log not found <SPACE> to continue:');
            ch:=fetch;
            clr_prompt;
          end;
      until found or (t[1] = ' ');
      if not found then i:=loglist.currentlog;
      new:=i;
      clr_prompt;
    end;

    procedure do_create;
    var i:integer;
        s:short_str;
        dummy1,dummy2,found:boolean;
        ch:char;
    begin
      s:='';
      repeat
        clr_prompt;
        write('Enter new log name: ');
        editfield(22,1,6,FALSE,dummy1,dummy2,s);
        s:=upcasestr(s);

        { search for duplicate }
        found:=FALSE;
        for i:=1 to MAXLOGS do
          if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
        if found then
          begin
            clr_prompt;
            write(output,s,': Duplicate log name <SPACE> to continue:');
            ch:=fetch;
            clr_prompt;
          end;
      until not found;

      { add name if not full }
      i:=0;
      while (i < MAXLOGS) and not found do
        begin
          i:=i + 1;
          if loglist.log[i].logname = '' then
            begin
              found:=TRUE;
              with loglist.log[i] do
                begin
                  logname:=s;
                  records:=0;
                  rec:=1;
                end;
              inc(loglist.logcount);
              put_loglist(loglist);
            end;
        end;
        if not found then
          begin
            clr_prompt;
            write(output,'Maximum number of logs exist <SPACE> to cont:');
            ch:=fetch;
            clr_prompt;
          end;
    end;

    procedure do_import;
    const db_name1 = 'SWSKED';

      procedure import(s:string);
      var found:boolean;
          rslt,i,j:integer;
          end_found:boolean;

        procedure move_db(logcnt:integer; var rslt:integer);
        var f:file;
            ch:char;
            i:integer;
            logdat:logtype;

          function read_file(chars:integer):string;
          var buf:array[1..255] of char;
              s:string;
              i:integer;
          begin
            rslt:=ioresult;
            s:='';
            if rslt <> 0 then read_file:=' '
            else
              begin
                blockread(f,buf,chars);
                for i:=1 to chars do s:=s + upcase(buf[i]);
                read_file:=s;
              end;
          end;

          procedure strip_header;
          var buf:array[1..610] of char;
          begin
            { strip off first 610 characters and discard }
            blockread(f,buf,610);
            rslt:=ioresult;
          end;

          procedure get_entry(logcnt:integer);
          var logdat: logtype;
              freqs:array[1..10] of real;
              comments:array[1..10] of string[COMMENTLEN];
              i:integer;

            procedure get_location;
            var s:string;
                i:integer;
                test:boolean;

              function str_compare(s1,s2:string):boolean;
              var i:integer;
                  match:boolean;
              begin
                match:=length(s1) = length(s2);
                if match then for i:=1 to length(s1) do
                  if match then match:= s1[i] = s2[i];
                str_compare:=match;
              end;

            begin
              s:=read_file(20);
              end_found:= pos(chr(26),s) <> 0;
              while length(s) < LOCATIONLEN do s:=s + ' ';
              logdat.location:=s;
            end;

            procedure get_station_id;
            var s:string;
            begin
              s:=read_file(24);
              while length(s) < CALLSIGNLEN do s:=s + ' ';
              logdat.callsign:=s;
            end;

            procedure get_start_time;
            begin
              logdat.begin_time:=read_file(4);
            end;

            procedure get_end_time;
            begin
              logdat.end_time:=read_file(4);
            end;

            function  get_freq:real;
            var freq:real;
                i:integer;
                s:string;
            begin
              freq:=0.0;
              s:=read_file(5);
              for i:=1 to 5 do
                begin
                  if (s[i] in ['0'..'9'])
                     then freq:=freq * 10 + (ord(s[i]) - ord('0'));
                end;
              get_freq:=freq;
            end;

            procedure get_comment;
            var s:string;
                i:integer;
                ch:char;

              procedure parse_comment(var s:string);
              var num1,num2,i,j:integer;
                  ch,separator:char;
                  s1,cmd:string;
                  found:boolean;

                procedure get_num(var s:string; var num:integer);
                var i:integer;
                    found:boolean;
                begin
                  num:=0;
                  found:=FALSE;
                  while not found do
                    begin
                      num:=num * 10 + ord(s[1]) - ord('0');
                      delete(s,1,1);
                      found:=(s = '') or not (s[1] in ['0'..'9']);
                    end;
                end;

                procedure get_next_comment(var str:string);
                var i:integer;
                begin
                  i:=pos('#',s) - 1;
                  if i<=0 then i:=length(s);
                  str:=copy(s,1,i);
                  delete(s,1,i);
                end;

                procedure do_range; { case: #n-m }
                var i:integer;
                    str:string;
                begin
                  get_next_comment(str);
                  for i:=num1 to num2 do comments[i]:=comments[i] + str;
                  { handle case #m-n,o,... }
                  if cmd <> '' then while cmd[1] = ',' do
                    begin
                      delete(cmd,1,1);
                      get_num(cmd,num1);
                      comments[num1]:=comments[num1] + str;
                    end;
                end;

                procedure do_list; { case: #n,o,p...}
                var i:integer;
                    str:string;
                begin
                  get_next_comment(str);
                  comments[num1]:=comments[num1] + str;
                  comments[num2]:=comments[num2] + str;
                  if cmd <> '' then while cmd[1] = ',' do
                    begin
                      delete(cmd,1,1);
                      get_num(cmd,num1);
                      comments[num1]:=comments[num1] + str;
                    end;
                end;

                procedure do_entry; { case: #n }
                var str:string;
                begin
                  get_next_comment(str);
                  comments[num1]:=comments[num1] + str;
                end;

                procedure do_both; { case: #n&m }
                var i:integer;
                    str:string;
                begin
                  get_next_comment(str);
                  comments[num1]:=comments[num1] + str;
                  comments[num2]:=comments[num2] + str;
                  if cmd <> '' then while cmd[1] = '&' do
                    begin
                      delete(cmd,1,1);
                      get_num(cmd,num1);
                      comments[num1]:=comments[num1] + str;
                    end;
                end;

              begin { parse comment }
                { check for comment unique to entries }
                i:=pos('#',s);
                if i = 0 then i:=length(s) + 1;
                { copy message up to command to each comment }
                s1:=copy(s,1,i - 1);
                for j:=1 to 10 do comments[j]:=comments[j] + s1;

                { get comments unique to entry eg #4&5 }
                cmd:='';
                j:=i + 1;
                found:=FALSE;
                while (j < length(s)) and not found do
                  begin
                    found:=s[j] in [' ','#'];
                    if not found then
                      begin
                        cmd:=cmd + s[j];
                        inc(j);
                      end;
                  end;
                delete(s,1,j - 1);

                { decode unique comments and assign }
                {   known formats: #n, #n&m, #n,m,...,#n-m }
                get_num(cmd,num1);
                if cmd <> '' then
                  begin
                    separator:=cmd[1];
                    delete(cmd,1,1);
                    get_num(cmd,num2);
                  end;
                case separator of
                  '-': do_range;
                  '&': do_both;
                  ',': do_list;
                  else do_entry;
                end;
              end;

            begin { get_comment }
              for i:=1 to 10 do comments[i]:='';
              s:='Target:' + read_file(40);
              { parse comments for individual entries }
              while length(s) > 0 do parse_comment(s);
              for i:=1 to 10 do while length(comments[i]) < COMMENTLEN do
                 comments[i]:=comments[i] + ' ';
            end;

            procedure get_date;
            var s:string;
            begin
              s:=read_file(2); { discard decade ie 19 }
              logdat.date:=read_file(6);
            end;

            procedure skip;
            var dummy:string;
            begin
              dummy:=read_file(9);
            end;

          begin { get_entry }
            { set variables that won't change for the duration }
            with logdat do
              begin
                agc:=FAST;
                mode:=USB;
                bandwidth:=INTER;
              end;
            get_location;
            if end_found then exit;
            get_station_id;
            get_start_time;
            get_end_time;
            for i:=1 to 10 do freqs[i]:=get_freq;
            get_comment;
            get_date;
            skip;
            for i:=1 to 10 do
              begin
                if freqs[i] <> 0.0 then
                  begin
                    with loglist.log[logcnt] do
                      begin
                        inc(records);
                        write(output,'.');
                        if records < MAXREC then
                          begin
                            logdat.comment:=comments[i];
                            logdat.frequency:=freqs[i];
                            logdat.attenuator:=NO;
                            put_log(logbuf,logdat,records);
                          end;
                      end;
                  end;
              end;
          end;

        begin { move_db }
          assign(f,PATH+S+'.DBF');
          reset(f,1);
          rslt:=ioresult;
          if rslt <> 0 then
            begin
              writeln(output,
                   'Must have ',PATH+S+'.DBF in directory to import');
              hndlerr(TRUE,ch,rslt);
              exit;
            end;
          strip_header;
          home;
          write(output,'Reading / parsing database');
          end_found:=false;
          while (rslt = 0) and not end_found do get_entry(logcnt);
          close(f);
          records:=loglist.log[loglist.currentlog].records;
          for i:=1 to MAXREC do
            begin
              recdata.recptr[i]:=i;
              recdata.recstat[i]:=SHOW;
            end;
          put_recdata(loglist.currentlog,recdata);
          put_loglist(loglist);
          rslt:=0;
        end;

        procedure eliminate_dups(lognum:integer);
        { collapse entries with time overlap }
        var rec1ptr,i,j,t,rslt:integer;
            logdata1,logdata2:logtype;
        begin
          home;
          write(output,'Crunching duplicate entries');
          get_log(logbuf,logdata1,recdata.recptr[1]);
          rec1ptr:=1;
          i:=2;
          while (i < loglist.log[lognum].records) do
            begin
              if recdata.recstat[recdata.recptr[i]] = DELETED then exit;
              get_log(logbuf,logdata2,recdata.recptr[i]);
              write(output,'.');
              if (logdata2.frequency  = logdata1.frequency) and
                 (logdata2.begin_time = logdata1.end_time)  and
                 (logdata2.comment    = logdata1.comment)   and
                 (logdata2.location   = logdata1.location)  and
                 (logdata2.callsign   = logdata1.callsign) then
                begin
                  logdata1.end_time:=logdata2.end_time;
                  put_log(logbuf,logdata1,recdata.recptr[rec1ptr]);
                  t:=recdata.recptr[i];
                  recdata.recstat[t]:=DELETED;
                  for j:=i to records - 1 do with recdata do
                     recptr[j]:=recptr[j + 1];
                  recdata.recptr[records]:=t;
                end
              else { no match }
                begin
                  logdata1:=logdata2;
                  rec1ptr:=i;
                  inc(i);
                end;
            end;
        end;

      begin { import }
        found:=FALSE;
        i:=0;
        while not found and (i < MAXLOGS) do
          begin
            inc(i);
            if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
          end;
        if found then
          begin
            with loglist.log[i] do
               begin
                 logname:=s;
                 records:=0;
                 rec:=1;
               end;
          end
        else { add name if not full }
          begin
            i:=0;
            while (i < MAXLOGS) and not found do
              begin
                i:=i + 1;
                if loglist.log[i].logname = '' then
                  begin
                    found:=TRUE;
                    inc(loglist.logcount);
                    put_loglist(loglist);
                  end;
              end;
            if not found then
              begin
                clr_prompt;
                write(output,'Maximum number of logs exist <SPACE> to cont:');
                ch:=fetch;
                clr_prompt;
                exit;
              end;
            with loglist.log[i] do
               begin
                 logname:=s;
                 records:=0;
                 rec:=1;
               end;
          end;
        loglist.currentlog:=i;
        open_log(logbuf,i,rslt);
        move_db(i,rslt);
        if rslt = 0 then
          begin
            home;
            do_sort(TRUE);
            eliminate_dups(i);
            put_recdata(loglist.currentlog,recdata);
          end;
        close(logbuf);
      end;

    begin
      import(db_name1);
    end;

    procedure do_export;
    var i:integer;
        dummy:boolean;
        logdata:logtype;
        dbfbuf:text;

      procedure open_dbf(s:string);
      var ch:char;
      begin
        assign(dbfbuf,PATH + s + '.DBF');
        repeat
          rewrite(dbfbuf);
          rslt:=ioresult;
          hndlerr(FALSE,ch,rslt);
        until (rslt = 0) or (ch = KEYINFO.ESCKEY);
      end;

      procedure write_dbf_header;
      const VERSION_NUM = 03;
      var s:string;
          yr,mo,dy,dyofweek:word;
          rec_lsb, rec_msb:byte;
      begin
        { byte 0: write version number }
        write(dbfbuf,chr(VERSION_NUM));

        { byte 1-3: write update date YY, MM, DD }
        getdate(yr,mo,dy,dyofweek);
        yr:=yr mod 100;
        write(dbfbuf,chr(yr) + chr(mo) + chr(dy));

        { byte 4-7: write number of records LSB--MSB }
        rec_msb:=records div 256;
        rec_lsb:=records mod 256;
        write(dbfbuf,chr(rec_lsb),chr(rec_msb),chr(0),chr(0));

        { byte 8-9: length of header structure }

        { byte 10-11: length of the record }

        { byte 12-31: reserved; write 00 }

        { byte 32-n: field descriptors - one per field }

           { byte 0-10: field name }
           { byte 11: field type - "C" = character
                                   "N" = numeric (not used)
                                   "L" = logical (not used)
                                   "M" = memo (not used)
                                   "D" = date (YYYYMMDD)}
           { byte 12-15: field data address }
           { byte 16: field length }
           { byte 17: field decimal count }
           { byte 18-21: reserved; write 00 }
      end;

      procedure write_dbf_record(logdata:logtype);
      begin
        with logdata do
          begin
          end;
      end;

    begin
      i:=0;
      with loglist do
        begin
          open_log(logbuf,currentlog,rslt);
          open_dbf(log[currentlog].logname);
        end;
      write_dbf_header;
      while (i < records) do
        begin
          dummy:=precess(i,1);
          get_log(logbuf,logdata,recdata.recptr[i]);
          write_dbf_record(logdata);
        end;
      close(logbuf);
      close(dbfbuf);
    end;

    procedure do_delete;
    var i:integer;
        s1:short_str;
        dummy1,dummy2,found:boolean;
        ch:char;
        f:file;
    begin
      do_select('to DELETE',i,found);
      if found then
        begin
          clr_prompt;
          write(output,'DELETE ',upcasestr(loglist.log[i].logname),'?');
          ch:=upcase(fetch);
          clr_prompt;
          if ch = 'Y' then
            begin
              loglist.log[i].logname:='';
              loglist.log[i].records:=0;
              loglist.log[i].rec:=0;
              loglist.logcount:=loglist.logcount - 1;
              if loglist.currentlog = i then loglist.currentlog:=0;
              if last_log = i then last_log:=0;
              put_loglist(loglist);
              str(i,s1);
              if length(s1) = 1 then s1:='0' + s1;
              s1:=s1 + '.DAT';
              assign(f,PATH + RECDATAFILE + s1);
              erase(f);
              assign(f,PATH + LOGFILE + s1);
              erase(f);
            end;
        end;
    end;

    procedure display_logs;
    var i,j,k,deletions:integer;
        t:string;
        recdata:recdatatype;
    begin
      gotoxy(1,4);
      call_crt(ERASEOS);
      j:=0;
      for i:=1 to MAXLOGS do
        begin
          t:=loglist.log[i].logname;
          if t <> '' then { display it }
            begin
              inc(j);
              deletions:=0;
              get_recdata(i,recdata);
              for k:=1 to loglist.log[i].records do
                if recdata.recstat[k] = DELETED then inc(deletions);
              writeln(output,j:3,'  ',t,' ',loglist.log[i].records
                                  - deletions);
            end;
        end;
    end;

    procedure move_record(marked, move:boolean; dest, from:byte);
    var x_pos,y_pos:integer;
      t,recnum:integer;
      ch:char;
      i,j:integer;
      dummy:boolean;
      logdata:logtype;
      to_recdata,from_recdata:recdatatype;
      found:boolean;
      from_buf,to_buf:file;

      function get_logentry(i:integer;var logdata:logtype):boolean;
      var found:boolean;
          j,k,l:integer;
      begin
        found:=TRUE;
        j:=from_recdata.recptr[i];
        if marked then found:=(i >=min_mark) and (i <=max_mark);
        found:=found and (from_recdata.recstat[j] = SHOW);
        if found then
          begin
            get_log(from_buf,logdata,j);
            if move then { delete old entry }
                from_recdata.recstat[j]:=DELETED;
          end;
        get_logentry:=found;
      end;

      procedure put_logentry(var i:integer; logdata:logtype);
      var j:integer;
      begin
        while (i < loglist.log[dest].records)
          and (to_recdata.recstat[to_recdata.recptr[i]] <> DELETED)
                  do inc(i);
        if (i >= loglist.log[dest].records)
           and (to_recdata.recstat[to_recdata.recptr[i]] <> DELETED) then
        { insert new entry here }
          begin
            inc(loglist.log[dest].records);
            i:=loglist.log[dest].records;
            to_recdata.recptr[i]:=i;
            if recnum = 0 then recnum:=1;
          end;
        t:=to_recdata.recptr[i];
        for j:=i downto recnum + 1 do with to_recdata do
          recptr[j]:=recptr[j - 1];
        to_recdata.recptr[recnum]:=t;
        to_recdata.recstat[t]:=SHOW;
        put_log(to_buf,logdata,to_recdata.recptr[recnum]);
        inc(recnum);
      end;

      procedure push_delete;
      { push deleted records to the end of the chain }
      var i,j,k,cnt,last:integer;
      begin
        last:=loglist.log[from].records;
        i:=1; cnt:=1;
        while (cnt < last) do
        { move deletions to the top of the stack; "cnt" limits iterations }
          begin
            j:=from_recdata.recptr[i];
            if from_recdata.recstat[j] = DELETED then
              begin
                for k:=i to last - 1 do
                  from_recdata.recptr[k]:=from_recdata.recptr[k + 1];
                from_recdata.recptr[last]:=j;
              end
            else inc(i);
            inc(cnt);
          end;
      end;

    begin {move_record }
      recnum:=loglist.log[dest].rec;
      get_recdata(from,from_recdata);
      get_recdata(dest,to_recdata);
      open_log(from_buf,from,rslt); if rslt > 0 then exit;
      open_log(to_buf,dest,rslt);   if rslt > 0 then exit;
      j:=1;
      for i:=1 to loglist.log[from].records do
        begin
          found:=get_logentry(i,logdata);
          if found then put_logentry(j,logdata);
        end;
      if move then push_delete;
      close(to_buf);
      close(from_buf);
      put_recdata(dest,to_recdata);
      put_recdata(from,from_recdata);
      put_loglist(loglist);
    end;

    procedure do_the_write;
    var dest:integer;
        found:boolean;
    begin
      do_select('to write to',dest, found);
      if found then move_record(TRUE,FALSE,dest,loglist.currentlog);
    end;

    procedure do_move;
    var dest:integer;
        found:boolean;
    begin
      do_select('to move to',dest, found);
      if found then
        begin
          move_record(TRUE,TRUE,dest,loglist.currentlog);
          do_unmark(FALSE);
        end;
    end;

    procedure do_print;

    const LINESPERPAGE = 60;

    var pbuf:text;
        i,cnt:integer;
        dummy:boolean;
        logdata:logtype;
        s:short_str;
        s1:string;
        logbuf:file;
        rslt:integer;

      procedure printhdr;
      begin
        write(pbuf,'Num   Date  Strt End  Freq     '+
                          'Station ID          Location');
        writeln(pbuf,'Comment':22,'Md':35,' BW');
        cnt:=1;
      end;

    begin
      assign(pbuf,'LPT1');
      rewrite(pbuf);
      write(pbuf,chr(27),'g'); { compressed mode }
      printhdr;
      i:=0;
      open_log(logbuf,loglist.currentlog,rslt);
      while (i < records) do
        begin
          dummy:=precess(i,1);
          get_log(logbuf,logdata,recdata.recptr[i]);
          if (i >= min_mark) and (i <= max_mark) then
            begin
              inc(cnt);
              if cnt > LINESPERPAGE then
                begin
                  write(pbuf,chr(12)); { form feed }
                  printhdr;
                end;
              with logdata do
                begin
                  write(pbuf,i:4,date:DATELEN + 1,begin_time:TIMELEN + 1);
                  write(pbuf,end_time:TIMELEN + 1);
                  write(pbuf,frequency:9:2,callsign:CALLSIGNLEN + 1);
                  s1:=copy(location,1,22);
                  while length(s1) < 22 do s1:=s1 + ' ';
                  write(pbuf,s1:23);
                  s1:=copy(comment,1,39);
                  while length(s1) < 39 do s1:=s1 + ' ';
                  write(pbuf,s1:40);
                  case mode of
                    RTTY:     s:='RT';
                    CW:       s:='CW';
                    USB:      s:='UB';
                    LSB:      s:='LB';
                    AM:       s:='AM';
                    FM:       s:='FM';
                    FAX:      s:='FX';
                    ECSS_USB: s:='Eu';
                    ECSS_LSB: s:='El';
                  end;
                  write(pbuf,s:3);
                  case bandwidth of
                    NARR:  s:='NR';
                    INTER: s:='IN';
                    WIDE:  s:='WD';
                    AUX:   s:='AX';
                  end;
                  writeln(pbuf,s:3);
                end;
            end;
        end;
      close(pbuf);
      close(logbuf);
    end;

  begin
    sync_loglist;
    close(logbuf);
    repeat
      write_prompt('Journal: '+
   'S(elect, C(reate, D(el, I(mport, W(rite, M(ove, P(rint, Q(uit');
      bottom_window;
      home;
      display_logs;
      repeat
        { check for timer tick }
        time_date_stamp(mon_str,day_str,year_str,time_str,FALSE);
        if time_str <> old_time_str then
          begin
            update_time_status;
            old_time_str:=time_str;
          end;
      until keypressed;
      ch:=upcase(fetch);
      case ch of
        'S','Q':begin
                  do_select('to switch to', new, found);
                  last_log:=new;
                  if loglist.currentlog = last_log then last_log:=0;
                  put_loglist(loglist);
                  cmd_prompt(prompt_num);
                  do_alternate;
                  exit;
                end;
        'C': do_create;
        'D': do_delete;
        'W': do_the_write;
        'M': do_move;
        'P': do_print;
        'I': do_import;
        'E': {do_export};
      end;
    until (ch = 'Q');
  end;

  procedure call_do_help;
  begin
    do_help;
    show_log(rec,TRUE,TRUE);
  end;

begin { nrd }
  graph_init;
  old_time_str:='';
  old_time_stamp:=0;
  last_log:=0;
  enable_s_meter:=FALSE;
  init_com;
  if has_map then
    begin
      remote_on;  { get receiver status to see if map is on }
      remote_off(0);
      map:=receiverstat.mode = AM;  { assume MAP in use if radio in AM }
    end
  else map:=FALSE;
  prompt_num:=PAGE1;
  get_loglist(loglist);
  new_log(loglist.currentlog,rslt);
  init_crt;
  x_pos:=1; y_pos:=1;
  gotoxy(x_pos,y_pos);
  do_unmark(TRUE);

  { init old receiver status to current radio settings }
  oldstat:=receiverstat;
  if radio_type = 535 then
    begin
      toggle_remote; { get radio status; dial changes will be cont sent }
      show_receiver;
    end;
  repeat
    repeat
      if (radio_type = 535) and async_buffer_check(ch) then
        begin
          check_status(s); { they changed dial }
          show_receiver;
        end;

      { check for timer tick }
      time_date_stamp(mon_str,day_str,year_str,time_str,FALSE);
      if time_str <> old_time_str then
        begin
          if enable_s_meter then timed_s_meter;
          update_time_status;
          old_time_str:=time_str;
        end;

      if update_receiver_display then
        begin
          if radio_type = 525 then
            begin
              remote_on;
              show_receiver;
              remote_off(REMOTE_DLY);
            end
          else
            begin
              toggle_remote;
              show_receiver;
            end;
          update_receiver_display:=FALSE;
        end;
      until keypressed;
    ch:=upcase(fetch);
    case ch of
      '@':; { nop }
      '+':              inc_freq;
      '-':              dec_freq;
      '*':              find_freq;
      '/':              begin
                          if prompt_num = PAGE1 then prompt_num:=PAGE2
                                                else prompt_num:=PAGE1;
                          cmd_prompt(prompt_num);
                          bottom_window;
                        end;
      'A':              begin
                          close(logbuf);
                          do_alternate;
                        end;
      'C':              do_confirm;
      'P':              do_page;
      'S':              do_sort(FALSE);
      'E':              do_edit;
      'G':              do_graph;
      'J':              do_journal;
      'D':              do_delete;
      'N':              do_undelete;
      'M':              do_mark;
      'U':              do_unmark(TRUE);
      'L':              do_log;
      'R':              begin
                          enable_s_meter:=not enable_s_meter;
                          if not enable_s_meter then
                            begin
                              top_window;
                              gotoxy(42,3);
                              write(output,'          ');
                              bottom_window;
                            end;
                        end;
      'T':              do_tune;
      'K':              if has_map then do_kiwa;
      'W':              do_write;
      '>':              inc_mode;
      '.':              inc_mode;
      '<':              dec_mode;
      ',':              dec_mode;
      ']':              inc_bandwidth;
      '[':              dec_bandwidth;
      'H':              begin
                          call_do_help;
                          status_window;
                        end;
      PAGEUP:           do_pageup(1);
      PAGEDOWN:         do_pagedown(1);
      UP:               do_up;
      DOWN:             do_down;
      RIGHTARROW:       do_right;
      LEFTARROW:        do_left;
      BACKTAB:          do_backtab;
      TAB:              do_tab;
      CTRLPAGEUP:       do_pageup(10);
      CTRLPAGEDN:       do_pagedown(10);
      HOMEKY:           do_home;
      ENDKY:            do_end;
      else update_receiver_display:=TRUE;
    end;
  until ch = 'Q';
  if radio_type = 535 then information_mode_off;
  sync_loglist;
  close(logbuf);
  window(1,1,80,25);
  home;
  gotoxy(1,8);
  writeln(output,'Send comments and suggestions to:');
  writeln(output);
  writeln(output,'    Tom Whiteside [phone]');
  writeln(output,'    11505 Oak View');
  writeln(output,'    Austin, TX 78759');
end.  { nrd }